home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / cad / acadlsp.zip / ARGH.LSP < prev    next >
Text File  |  1987-06-24  |  6KB  |  82 lines
  1. ; (c) 1986,1987 New Riders Publishing 
  2. ;*Set your TAB spacing to 2, and print this file with a 132 col width
  3.  
  4. (prompt "\nThis is ACAD.LSP for WORKOUT... ")        ;* displays the prompt as file loads
  5.  
  6. (vmon)                                               ;* turns virtual memory on for subsequent LISP functions (defun)s
  7.  
  8. ;*  creates a user "COMMAND" that applies ALL specified CHANGE(S) to SELECTED TEXT strings
  9. (defun  C:CHGTXT (/ pr pr1 s h r x str ss)           ; identifies all variables as "local"
  10.   (setq pr "Enter new ")                             ; pr = a partial prompt
  11.   (setq pr1 ", or   hit a <CR> for no change... ")   ; pr1 = a partial prompt
  12.   (setq S ""    H ""     R ""     X ""     str T )   ; initializes variables
  13.   (prompt "Select text entities to change... ")
  14.   (setq ss (sslength (ssget)))                       ; ssget selects entities in the data base
  15.                                                      ; ss = sslength, how many entities were selected?
  16.   (while (not (eq str ""))                           ; loops thru input of changes until <CR> only is hit
  17.     (prompt "\nChange Style/Height/Rotation/or teXt string? ")
  18.     (setq str (strcase (getstring "\nEnter S,H,R or X,  or hit a <CR> to execute... ")))
  19.                                                      ; str = gets WHAT to change,
  20.                                                      ; strcase converts input to UPPERCASE for testing
  21.     (if (member  str '("S" "H" "R" "X"))             ; gets what to CHANGE IT TO if str tests as valid input
  22.       (cond                                          ; s,h,r or x = gets CHANGE IT TO input in
  23.                                                      ; correct format to match str
  24.                                                      ; strcat combines partial prompts with "quoted key words"
  25.         ((eq str "H")  (setq h (getreal     (strcat pr  "Height"  pr1)))
  26.           (if (numberp h) nil (setq h ""))           ; tests h, makes it a nil string "" if 
  27.         )                                            ; <CR> or invalid input was entered
  28.         ((eq str "S")  (setq s (getstring   (strcat pr  "Style"   pr1))))
  29.         ((eq str "X")  (setq x (getstring T (strcat pr  "teXt string" pr1))))
  30.         ((eq str "R")  (setq r (getangle    (strcat pr  "Rotation angle" pr1)))
  31.           (if (numberp r) (setq r  (strcat "<<" (angtos r 0 4))) (setq r ""))
  32.         )                                            ; if tests r, makes it a nil string "" if <CR> or invalid input 
  33.                                                      ; was entered; Otherwise strcat & angtos convert angle to
  34.                                                      ; universal format <<nnn.dddd string
  35.   ) ) )                                              ; closes while, if & cond
  36.   (command "CHANGE" "P" "" "" "" S H R X)            ; initiates CHANGE cmd & applies changes to first text entity
  37.   (while (not (eq (setq ss (1- ss)) 0)) (command "" S H R X))
  38.                                                      ; loop thru CHANGE cmd, count down ss until
  39.                                                      ; all selected entities are changed
  40. )                                                    ; close defun
  41.  
  42. ;* TRANSPARENT SNAP/GRID, call from menu w/...
  43. ;           'SETVAR SNAPUNIT (trsnpgr);\'SETVAR GRIDUNIT !V2 ^G^G
  44. ; uses new or restores prev saved value, independent of SNAPUNIT GRIDUNIT variables,
  45. ; has user resetable GRID ratio (multiplier)
  46. (setq sgmult 10 sinc (car (getvar "snapunit")))      ; initializes
  47. (defun trsnpgr ()
  48.   (prompt (strcat
  49.     "\nTo respec snap/grid Multiplier <" (rtos sgmult 2 2) "X>, preface SNAP value w/ - (eg: -.125)"))
  50.   (setq v (getreal (strcat
  51.     "\nEnter <->SNAP value or <CR> for <" (rtos sinc) ">... ")))
  52.   (if v                                              ; tests for <CR> (nil)
  53.     (progn                                           ; resets sinc & uses new
  54.       (if (minusp v)
  55.           (progn
  56.             (setq sgmult (getreal "Enter new Snap/Grid Multiplier... "))
  57.             (setq v (abs v))
  58.           )
  59.       )                                              ; closes if
  60.       (setq v (list (setq sinc v) v))                ; value for SNAP
  61.     )                                                ; closes progn
  62.     (setq v (list sinc sinc))                        ; uses old value
  63.   )                                                  ; closes if
  64.   (setq v2 (list (* sgmult sinc) (* sgmult sinc)))   ; variable for GRID
  65.   (setq v v)                                         ; returns value of last expression for SNAP
  66. )                                                    ; closes defun
  67.  
  68. ;*For T1-188 Transparent SNAP
  69. ; call from menu w/...       'SETVAR SNAPUNIT (trsnap);
  70. ; uses new or restores prev saved value, independent of SNAPUNIT variable
  71. (setq sinc (car (getvar "snapunit")))                ; initializes sinc
  72. (defun trsnap ()
  73.   (if (setq v (getreal (strcat                       ; tests for <CR>
  74.     "\nEnter SNAP value or <CR> for <" (rtos sinc) ">... ")))
  75.     (setq v (list (setq sinc v) v))                  ; resets sinc & uses new
  76.     (setq v (list sinc sinc))                        ; uses old value
  77. ) )                                                  ; closes if & defun
  78. ; Developed By B. Rustin Gesner, FOR WORKING OUT WITH AutoCAD By Martha Lubow
  79. (defun Cdate ( /CD)
  80.     (setq CD (rtos (getvar "Cdate") 2 6))
  81.     (strcat (substr CD 5 2) "/" (substr CD 7 2) "/" (substr CD 3 2) " "
  82.             (substr CD 10 2) ":" (substr CD 12 2) ":" (substr CD 14 2)))